home *** CD-ROM | disk | FTP | other *** search
/ Windows Expert / Windows Expert.iso / communic / pbbs190b.zip / PDOOR10.EXE / POWRSYS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-01  |  18KB  |  533 lines
  1. {$N-,V-,B-,S-,R-,D-}
  2.  
  3. (*----------------------------------------------------------------------*)
  4. (* Program: PowrSYS - SysOp Menu for PowerBBS by Russell Frey           *)
  5. (*                                                                      *)
  6. (* Date: September 26, 1991                                             *)
  7. (*                                                                      *)
  8. (* Source code to the PowerBBS SysOp's Menu in PowerDOOR format.        *)
  9. (* Update this program, and you can replace the PowerBBS Sysop Features *)
  10. (*                                                                      *)
  11. (* You are free to modify and distribute.                               *)
  12. (*----------------------------------------------------------------------*)
  13. (* There are many modifications that can be done to improve this source *)
  14. (* code.  So have fun modifying and learning PowrDOOR!                  *)
  15. (*----------------------------------------------------------------------*)
  16. (* If you have modifications to this file, that you would like to       *)
  17. (* distribute, please upload it to the support bbs.                     *)
  18. (*----------------------------------------------------------------------*)
  19.  
  20. Program PowerBBS_SysOp_Menu_Door;
  21.  
  22. uses windos,winprocs,strings,powrwin,powrcolr,powrdoor,fileio;
  23.  
  24. type
  25.    char2 = array [1..2] of char;
  26.  
  27.    powr_caller_rec = record
  28.       message:        array[1..75] of char;
  29.       crlf:           char2;
  30.    end;
  31.  
  32. var
  33.    UserTemp: PowrUser;
  34.    powr_caller:    powr_caller_rec;
  35.  
  36.    K,N,KK,MM : Integer;
  37.    L : String;
  38.  
  39.    i:   integer;
  40.    ofd:        text;
  41.    Pass : Boolean;
  42.    Temp42 : String;
  43.    R : Integer;
  44.  
  45.    Temps5: String;
  46.  
  47. (* -------------------------------------------------------------------- *)
  48. Function Show_Boolean(TrueFalse : Boolean) : String;
  49.  
  50. Begin
  51.  if Truefalse then Show_Boolean := 'Yes'
  52.               else Show_Boolean := 'No ';
  53. End;
  54.  
  55. (* -------------------------------------------------------------------- *)
  56. Procedure DisplayUpdate(Start1:   String;
  57.                          Info1:    String;
  58.                          Answer1:  String;
  59.                          Start2:   String;
  60.                          Info2:    String;
  61.                          Answer2:  String);
  62. Var
  63.  Tempstring1: String;
  64.  
  65. Begin
  66.  write_com(SENDWHITE);
  67.  write_com(' '+Start1+' ');
  68.  write_com(SENDCYAN);
  69.  write_com(Info1);
  70.  write_com(': ');
  71.  Tempstring1 := Answer1;
  72.  delete_after_spaces(Tempstring1);
  73.  write_com(SENDGREEN+Tempstring1);
  74.  writeln_com_spaces(36-(Length(Info1)+Length(Tempstring1)));
  75.  write_com(SENDWHITE+Start2+' ');
  76.  write_com(SENDCYAN);
  77.  write_com(Info2);
  78.  write_com(': ');
  79.  Tempstring1 := Answer2;
  80.  delete_after_spaces(Tempstring1);
  81.  write_com(SENDGREEN+Tempstring1);
  82.  writelncom;
  83. End;
  84.  
  85. (* -------------------------------------------------------------------- *)
  86. Procedure Get_Input(MaxStr : Integer;
  87.                     Question : String);
  88.  
  89. Begin
  90.  Repeat
  91.   writelncom;
  92.   Pass := True;
  93.   R := Length(Question) - 1;
  94.   writeln_com_border(R,Maxstr);
  95.   write_com(SENDGREEN+Question);
  96.   ask_user(Temp42,MaxStr);
  97.   upper_string(temp42);
  98.   delete_after_spaces(Temp42);
  99.   if Length(Temp42) < 1 then Pass := False;
  100.   if Pass = False then Begin
  101.                          writelncom;
  102.                          writeln_com(SENDYELLOW +'Invalid Response! Try Again. ');
  103.                        End;
  104.  Until (Pass = True) Or (drop_carrier);
  105.  writelncom;
  106. End;
  107.  
  108. (* -------------------------------------------------------------------- *)
  109. Procedure New_Birthday;
  110.  
  111. Var
  112.   Birth_Date: String;
  113.  
  114. Begin
  115.   writelncom;
  116.   write_com(SENDYELLOW+' Enter the date you were born ['+SENDWHITE+'MM-DD-YY'+
  117.        SENDYELLOW+']: ');
  118.   Get_Date(Birth_Date,False,'');
  119.   put_chars_into(UserTemp.Birthday,Birth_Date,Sizeof(UserTemp.Birthday));
  120. End;
  121.  
  122. (* -------------------------------------------------------------------- *)
  123. procedure mode_toggle;
  124.  
  125. Var
  126.   Temp724 : String;
  127.  
  128. begin
  129.   writelncom;
  130.   write_com(SENDYELLOW+'Monitor type: ['+SENDWHITE+'C'+SENDYELLOW+']olor, ['+SENDWHITE+
  131.        'M'+SENDYELLOW+']onochrome, or ['+SENDWHITE+'N'+SENDYELLOW+']one');
  132.   if GetInput(True,Temp724,1) then Exit;
  133.   if Temp724 = 'C' then
  134.                          UserTemp.Monitor_Type := 'C'
  135.  
  136. else if Temp724 = 'M' then
  137.                          UserTemp.Monitor_Type := 'M'
  138.                       else
  139.                          UserTemp.Monitor_Type := 'N';
  140. End;
  141.  
  142. (* -------------------------------------------------------------------- *)
  143. Procedure New_Password;
  144.  
  145. Var temp999 : STRING;
  146. Begin
  147.  Repeat
  148.   writelncom;
  149.   Get_Input(10,' Password (One word please!): ');
  150.   temp999 := Temp42;
  151.   Get_Input(10,'  Re-enter password to check: ');
  152.   if temp999 <> Temp42 then Begin
  153.                              writelncom;
  154.                              writeln_com(SENDYELLOW+' Password do not match ! ');
  155.                             End;
  156.  Until drop_carrier Or (temp999 = Temp42);
  157.   put_chars_into(UserTemp.Password,Temp42,sizeof(UserTemp.Password));
  158. End;
  159.  
  160. (* -------------------------------------------------------------------- *)
  161. Procedure New_VoicePhone;
  162.  
  163. Begin
  164.   writelncom;
  165.   write_com(SENDYELLOW+'Enter your HOME Phone # [XXX-XXX-XXXX]: ');
  166.   Get_A_Input('(###) ###-####',Temp42,False,'');
  167.   put_chars_into(UserTemp.Phone_Number,Temp42,sizeof(UserTemp.Phone_Number));
  168. End;
  169.  
  170. (* -------------------------------------------------------------------- *)
  171. Procedure New_City;
  172.  
  173. Begin
  174.   writelncom;
  175.   Get_Input(20,' City and State calling From? ');
  176.   put_chars_into(UserTemp.Location,temp42,sizeof(UserTemp.Location));
  177. End;
  178.  
  179. (* -------------------------------------------------------------------- *)
  180. Procedure New_Computer;
  181.  
  182. Begin
  183.   writelncom;
  184.   Get_Input(15,'    What is your Computer type? ');
  185.   put_chars_into(UserTemp.Computer,Temp42,sizeof(UserTemp.Computer));
  186. End;
  187.  
  188. (* -------------------------------------------------------------------- *)
  189. Procedure Set_Page;
  190.  
  191. Var
  192.   Temp25: String;
  193.   Halt: Boolean;
  194.  
  195. Begin
  196.   Halt := False;
  197.   temp25 := '';
  198.   writelncom;
  199.   write_com(SENDYELLOW+'Enter '+SENDWHITE+'PAGE Length'+SENDYELLOW+' ['+SENDWHITE+
  200.        'ENTER'+SENDYELLOW+'='+int_to_asc(UserTemp.Screen_lines)+']: ');
  201.   ask_user(TEMP25,2);
  202.   upper_string(TEMP25);
  203.   if temp25 = '' then Halt := True;
  204.   if Halt = False then UserTemp.Screen_lines := asc_to_int(TEMP25);
  205.   writelncom;
  206. End;
  207.  
  208.  
  209. (* -------------------------------------------------------------------- *)
  210. Procedure Sysop_SB;
  211.  
  212. Var
  213.   User_File: file_handle;
  214.   Num_users: LongInt;
  215.   Tempi6,Tempi7: Integer;
  216.  
  217. Begin
  218.    User_File := Open_File(UserFile_Path,2);
  219.    num_users := (seek_file(User_File,0,2) div sizeof(UserTemp))-1;
  220.    seek_file(user_file,0,0);
  221.    tempi6 := -1;
  222.    repeat
  223.       inc(tempi6);
  224.       Tempi7 := read_file(User_File,UserTemp,Sizeof(UserTemp));
  225.       writeln_com(SENDWHITE+rjust(int_to_asc(Tempi6+1),4)+'. '+SENDGREEN+UserTemp.Last_Call+
  226.               ' '+SENDYELLOW+UserTemp.Name+' '+SENDRED+UserTemp.Location+' '+SENDCYAN+
  227.               UserTemp.Last_Time+SENDWHITE+' '+rjust(UserTemp.Last_Time,3)+' Min');
  228.    until (tempi6 >= num_users) or (user_abort) or (drop_carrier);
  229.    close_file(User_File);
  230.    get_a_return;
  231. End;
  232.  
  233. (* -------------------------------------------------------------------- *)
  234. procedure display_activitylog(todisplay: string);
  235. var
  236.  Caller_FH:  file_handle;
  237.  tempi6, tempi7: longint;
  238.  temps1: string;
  239.  
  240. begin
  241.    Caller_FH := Open_File(todisplay,2);
  242.    tempi6 := seek_file(Caller_FH,0,2);
  243.    tempi6 := (tempi6 div sizeof(powr_caller))-1;
  244.    close_file(caller_FH);
  245.    caller_FH := Open_File(todisplay,2);
  246.    repeat
  247.      seek_file(caller_FH,tempi6*sizeof(powr_caller),0);
  248.      Tempi7 := read_file(Caller_FH,powr_caller,Sizeof(powr_caller));
  249.      temps1 := powr_caller.Message;
  250.      delete_after_spaces(temps1);
  251.      writeln_com(temps1);
  252.      dec(tempi6);
  253.    until (user_abort) or (drop_carrier) or (tempi6 < 1);
  254.    close_file(Caller_FH);
  255.    get_a_return;
  256. end;
  257.  
  258. (* -------------------------------------------------------------------- *)
  259. Procedure View_Caller;
  260. Var
  261.  temps1,tempactlog:   string;
  262.  
  263.  Begin
  264.    tempactlog := copy(CallerLog,1,length(CallerLog)-1);
  265.    writeln_com_node_status;
  266.    writelncom;
  267.    write_com('Enter Node # to view Actlog');
  268.    if getinput(false,temps1,2) then exit;
  269.    tempactlog := tempactlog + temps1;
  270.    if Not file_exists(tempactlog) then exit;
  271.    display_activitylog(tempactlog);
  272. End;
  273.  
  274. (* -------------------------------------------------------------------- *)
  275. Procedure Update_Conferences;
  276.  
  277. Var
  278.   Tempi10: Integer;
  279.   Temps11: String;
  280.  
  281. Begin
  282.   writelncom;
  283.    writeln_com(' Enter * for forums to give access, or [Enter] for no change.');
  284.    writeln_com('        0.........1.........2.........3.........4.........');
  285.    writeln_com_spaces(8);
  286.    For Tempi10 := 0 to 49 do
  287.     if bit_from_byte(UserTemp.Forum_Data[tempi10].Options,1) then
  288.       write_com('*')
  289.     else
  290.       write_com(' ');
  291.    writelncom;
  292.      write_com('Access= ');
  293.      ask_user(Temps11,50);
  294.      delete_after_spaces(Temps11);
  295.      if Temps11 <> '' then
  296.       Begin
  297.       For Tempi10 := 0 To 49 Do
  298.        set_bit_byte(UserTemp.Forum_Data[Tempi10].Options,1,False);
  299.       For Tempi10 := 1 to Length(Temps11) Do
  300.        set_bit_byte(UserTemp.Forum_Data[tempi10-1].Options,1,Copy(Temps11,Tempi10,1) = '*');
  301.       End;
  302.    writelncom;
  303.    writeln_com('        5.........6.........7.........8.........9.........');
  304.    writeln_com_spaces(8);
  305.    For Tempi10 := 50 to 99 do
  306.     if bit_from_byte(UserTemp.Forum_Data[tempi10].Options,1) then
  307.      write_com('*')
  308.     else
  309.      write_com(' ');
  310.    writelncom;
  311.      write_com('Access= ');
  312.      ask_user(Temps11,50);
  313.      delete_after_spaces(Temps11);
  314.      if Temps11 <> '' then
  315.      Begin
  316.       For tempi10 := 50 to 99 do
  317.        set_bit_byte(UserTemp.Forum_Data[Tempi10].Options,1,False);
  318.       For Tempi10 := 1 to Length(Temps11) Do
  319.        set_bit_byte(UserTemp.Forum_Data[tempi10+49].Options,1,Copy(Temps11,Tempi10,1) = '*');
  320.      End;
  321. End;
  322.  
  323. (* -------------------------------------------------------------------- *)
  324. Procedure User_Database_Update;
  325.  
  326. Var Hotkeym: Char;
  327.     Temp020 : String;
  328.     User_File: file_handle;
  329.     Num_Users: LongInt;
  330.     User_Num,Junki: Integer;
  331.     Temps6,temps7,Temps8,Temps15,Temps26: String;
  332.     Tempi8,Tempi9: Integer;
  333.     Tempi10: Integer;
  334.     PL,PP: Integer;
  335.     PA:    Real;
  336.     tempc25: char25;
  337.     tempw: word;
  338.  
  339. Begin
  340.  User_Num := 0;
  341.  Repeat
  342.   User_File := open_file(UserFile_Path,2);
  343.   num_users := (seek_file(user_file,0,2) div sizeof(UserTemp))-1;
  344.   ClearScreen;
  345.   if User_Num > Num_Users then User_Num := Num_Users - 1;
  346.   seek_file(user_file,user_num*sizeof(UserTemp),0);
  347.   Junki := read_file(User_File,UserTemp,Sizeof(UserTemp));
  348.   close_file(User_File);
  349.     writeln_com(SENDYELLOW+'Record # '+SENDWHITE+int_to_asc(User_num + 1)+SENDYELLOW+' of '+SENDWHITE+int_to_asc(Num_Users+1));
  350.     writelncom;
  351.     DisplayUpdate(' 1.','  User''s name',UserTemp.Name,' 2.','Dead & Locked Out',
  352.                     Show_Boolean(bit_from_byte(UserTemp.options,4)));
  353.     DisplayUpdate(' 3.',' Calling From',UserTemp.Location,' 4.',' Last Called',
  354.                    UserTemp.Last_Call+' '+UserTemp.Last_Time);
  355.     DisplayUpdate(' 5.','     Password','<Not Shown>',' 6.','  Sec. Level',
  356.                    int_to_asc(UserTemp.access));
  357.     DisplayUpdate(' 7.','     Birthday',UserTemp.Birthday,' 8.',' # Downloads',
  358.                    int_to_asc(UserTemp.Downloads)+'   '+double_to_kilobyte(UserTemp.Download_Bytes)+' k');
  359.     DisplayUpdate(' 9.','   Home Phone',UserTemp.Phone_Number,'10.','   # Uploads',
  360.                    int_to_asc(UserTemp.Uploads)+'   '+double_to_kilobyte(UserTemp.uploads_bytes)+' k');
  361.     DisplayUpdate('11.','       Expert',Show_Boolean(bit_from_byte(UserTemp.options,1)),
  362.                    '12.','     # Calls',int_to_asc(UserTemp.Calls));
  363.     DisplayUpdate('13.','     Computer',UserTemp.Computer,'14.',' # Msgs Left',
  364.                    int_to_asc(UserTemp.Messages_Left));
  365.     DisplayUpdate('15.','     Protocol',UserTemp.Xproto,'   ','','');
  366.     DisplayUpdate('16.','Screen Length',int_to_asc(UserTemp.Screen_lines),'   ','','');
  367.     DisplayUpdate('17.',' Monitor Type',UserTemp.Monitor_Type,'   ','','');
  368.     DisplayUpdate('18.','Expiring Date/Level',UserTemp.Expiration_Date+' '+int_to_asc(UserTemp.Expiration_Access),
  369.                    '   ','','');
  370.     writelncom;
  371.     writeln_com('        0.........1.........2.........3.........4.........5');
  372.       write_com('20.     ');
  373.     For Tempi10 := 0 to 50 Do
  374.      if bit_from_byte(UserTemp.Forum_Data[Tempi10].Options,1) then
  375.       write_com(chr(Tempi10 mod 10+ord('0')))
  376.      else
  377.       write_com(' ');
  378.     writelncom;
  379.     writeln_com_spaces(9);
  380.     For Tempi10 := 51 to 99 Do
  381.      if bit_from_byte(UserTemp.Forum_Data[Tempi10].Options,1) then
  382.       write_com(chr(Tempi10 mod 10+ord('0')))
  383.      else
  384.       write_com(' ');
  385.     writelncom;
  386.     writeln_com(infotext('Time Left: |MINLEFT|'));
  387.     writelncom;
  388.     write_com(SENDYELLOW+'[F]ind, [J]ump, [Q]uit, [1..20], [ENTER=Next]: ');
  389.     ask_user(Temps6,20);
  390.     upper_string(Temps6);
  391.     delete_after_spaces(Temps6);
  392.     Temp020 := Temps6;
  393.     writelncom;
  394.     if drop_carrier then exit;
  395.     case asc_to_int(Temps6) of
  396.      1: Begin
  397.            writelncom;
  398.            Get_Input(25,' New User Name? ');
  399.            put_chars_into(UserTemp.Name,Temp42,Sizeof(UserTemp.Name));
  400.           End;
  401.      2: set_bit_byte(UserTemp.options,4, Not bit_from_byte(UserTemp.options,4));
  402.      3: New_City;
  403.      4: Begin
  404.            Temps5 := UserTemp.Last_Call;
  405.            write_com(SENDYELLOW+'Enter Last Called ['+SENDWHITE+'DATE'+'], ['+SENDWHITE+'ENTER'+
  406.                 SENDYELLOW+'='+UserTemp.Last_Call+') (MM-DD-YY): ');
  407.            Get_A_Input('##-##-##',Temps5,True,Temps5);
  408.            put_chars_into(UserTemp.Last_Call,Temps5,Sizeof(UserTemp.Last_Call));
  409.            Temps5 := UserTemp.Last_Time;
  410.            write_com(SENDYELLOW+'Enter Last Called ['+SENDWHITE+'TIME'+'], ['+SENDWHITE+'ENTER'+
  411.                 SENDYELLOW+'='+Temps5+') (XX:XX): ');
  412.            Get_A_Input('##:##',Temps5,True,Temps5);
  413.            put_chars_into(UserTemp.Last_Time,Temps5,Sizeof(UserTemp.Last_Time));
  414.           End;
  415.      5: New_Password;
  416.      6: Begin
  417.            writelncom;
  418.            Get_Input(3,' New Security Level? ');
  419.            UserTemp.access := asc_to_int(Temp42);
  420.          End;
  421.      7: New_Birthday;
  422.      8: Begin
  423.            Get_Input(4,'   Total Number Of Downloads: ');
  424.            UserTemp.Downloads := asc_to_int(Temp42);
  425.            Get_Input(4,' Total Number Of K Downloads: ');
  426.            val(temp42,Pa,tempw);
  427.            PA := PA * 1024;
  428.            real_to_double(PA,UserTemp.Download_Bytes);
  429.           End;
  430.      9: New_VoicePhone;
  431.     10: Begin
  432.            Get_Input(4,'   Total Number Of Uploads: ');
  433.            UserTemp.Uploads := asc_to_int(Temp42);
  434.            Get_Input(4,' Total Number Of K Uploads: ');
  435.            val(temp42,Pa,tempw);
  436.            PA := PA * 1024;
  437.            real_to_double(PA,UserTemp.uploads_bytes);
  438.           End;
  439.     11: set_bit_byte(UserTemp.options,1, Not bit_from_byte(UserTemp.options,1));
  440.     12: Begin
  441.            writelncom;
  442.            Get_Input(3,' New Number Of Calls? ');
  443.            UserTemp.Calls := asc_to_int(Temp42);
  444.           End;
  445.     13: New_Computer;
  446.     14: Begin
  447.            Get_Input(4,' Total Number Of Messages Left: ');
  448.            UserTemp.Messages_Left := asc_to_int(Temp42);
  449.           End;
  450.     15: Begin
  451.            writelncom;
  452.            Get_Input(1,' New Default Protocol? ');
  453.            put_chars_into(UserTemp.Xproto,Temp42,Sizeof(UserTemp.Xproto));
  454.           End;
  455.     16: Set_Page;
  456.     17: Mode_Toggle;
  457.     18: Begin
  458.          writelncom;
  459.          write_com(' Enter Expiration Date: ');
  460.          Temp42 := UserTemp.Expiration_Date;
  461.          Get_Date(Temp42,True,Temp42);
  462.          put_chars_into(UserTemp.Expiration_Date,Temp42,Sizeof(UserTemp.Expiration_Date));
  463.          write_com('Enter Expiration Level: ');
  464.          ask_user(Temp42,3);
  465.          delete_after_spaces(Temp42);
  466.          if Temp42 <> '' then UserTemp.Expiration_Access := asc_to_int(Temp42);
  467.         End;
  468.     20: Update_Conferences;
  469.     End;
  470.    User_File := open_file(UserFile_Path,2);
  471.    seek_file(user_file,user_num*sizeof(UserTemp),0);
  472.    write_file(User_File,UserTemp,Sizeof(UserTemp));
  473.    close_file(User_File);
  474.    if Temps6 = 'J' then Begin
  475.     writelncom;
  476.     write_com(SENDYELLOW+'Jump: ('+SENDWHITE+'1..'+int_to_asc(Num_Users+1)+SENDYELLOW+')? ');
  477.     ask_user(Temps7,5);
  478.     delete_after_spaces(Temps7);
  479.     Tempi8 := asc_to_int(Temps7);
  480.     if (Tempi8 < 1) Or (Tempi8 > Num_Users+1) then Temps6 := 'Q';
  481.     User_Num := Tempi8 - 1;
  482.    End;
  483.    if Temps6 = 'F' then Begin
  484.     writelncom;
  485.     write_com(SENDYELLOW+'Enter Users '+SENDWHITE+'FULL NAME'+SENDYELLOW+': ');
  486.     ask_user(Temps7,25);
  487.     delete_after_spaces(Temps7);
  488.     upper_string(Temps7);
  489.     put_chars_into(tempc25,temps7,sizeof(tempc25));
  490.     Tempi8 := search_userrec_for(UserTemp,tempc25);
  491.     if tempi8 > 0 then user_num := tempi8 - 1;
  492.    End;
  493.    if Temps6 = '' then Begin
  494.      inc(user_num);
  495.      if User_Num > Num_Users then Temps6 := 'Q';
  496.      End;
  497.  Until (drop_carrier) Or (Temps6 = 'Q');
  498. End;
  499.  
  500. (* -------------------------------------------------------------------- *)
  501. procedure sysop_main_menu;
  502. var
  503.  menucommand: string;
  504.  
  505. const
  506.    None = '~';
  507. begin
  508.  repeat
  509.    writelncom;
  510.    type_file('\Powrbbs\Screen\SysOp');
  511.    writelncom;
  512.    write_com(SENDYELLOW+'SysOps Door Demo Command? ');
  513.    Repeat
  514.     Get_Hotkey(MenuCommand[1]);
  515.    Until drop_carrier or (MenuCommand[1] <> chr(13));
  516.    writeln_com(MenuCommand[1]);
  517.    if drop_carrier then exit;
  518.  
  519.    case menucommand[1] of
  520.          'A':  View_Caller;
  521.          'L':  Sysop_Sb;
  522.          'Q':  Exit;
  523.          'U':  User_Database_Update;
  524.       end;
  525.   until drop_carrier;
  526. end;
  527.  
  528. begin
  529.  begin_live_program('PowerSys - System_Door - (c) 1991 by Russell Frey');
  530.  Sysop_Main_Menu;
  531.  end_live_program;
  532. End.
  533.